home *** CD-ROM | disk | FTP | other *** search
/ SPACE 2 / SPACE - Library 2 - Volume 1.iso / telecom / 46 / pascal / ossprt.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1986-08-15  |  7.8 KB  |  275 lines
  1. PROGRAM Print;
  2.   {Print is in the Public Domain.  Print is an OSS Pascal Source Code Printing
  3.    Program by Barry Larson - Rochester, MN.  Print has the ability to print
  4.    the include files coded into OSS Pascal source files and can be customized
  5.    with easy constant changes.                                                }
  6.   CONST
  7.     {$I Gemconst.pas}
  8.     c_default_path              = 'A:\*.PAS';
  9.     c_lines_per_page            = 60;
  10.     c_ask_for_source            = TRUE;
  11.     c_headers_are_printed       = TRUE;
  12.     c_include_files_are_printed = TRUE;
  13.     c_oss_files_are_printed     = TRUE;
  14.     c_final_form_feed           = TRUE;
  15.     c_offer_line_numbers        = TRUE;
  16.   TYPE
  17.     {$I Gemtype.pas}
  18.   VAR
  19.     lert,
  20.     working,
  21.     defpath,
  22.     inpath,
  23.     linestr,
  24.     test: STR255;
  25.     pagecount,
  26.     linecount,
  27.     counter,
  28.     choice: INTEGER;
  29.     l_numbers: BOOLEAN;
  30.   {$I Gemsubs.pas}
  31.   PROCEDURE IO_Check(b: BOOLEAN);
  32.     EXTERNAL;
  33.   FUNCTION IO_Result: INTEGER;
  34.     EXTERNAL;
  35.   PROCEDURE Abort_Check;
  36.     BEGIN
  37.       IF KEYPRESS
  38.         THEN
  39.           BEGIN
  40.             choice := Do_Alert(
  41.             '[3][ | |Continue or Abort Printing ][ Continue | Abort ]',1);
  42.             IF (choice = 2)
  43.               THEN
  44.                 HALT;
  45.           END;
  46.     END{Abort_Check};
  47.   PROCEDURE Convert(number: INTEGER; Var tempstr: STR255);
  48.     BEGIN
  49.       tempstr := '';
  50.       WHILE (number > 0) DO
  51.         BEGIN
  52.           tempstr :=
  53.             CONCAT(CHR((number - ((number DIV 10) * 10)) + ORD('0')), tempstr);
  54.           number := (number DIV 10);
  55.         END;
  56.       IF ( (tempstr = '') OR (tempstr = ' ') )
  57.         THEN
  58.           tempstr := '0';
  59.     END{Convert};
  60.   PROCEDURE Header;
  61.     Var
  62.       temp1,
  63.       temp2: STR255;
  64.       counter: INTEGER;
  65.     BEGIN
  66.       IF c_headers_are_printed
  67.         THEN
  68.           BEGIN
  69.             Abort_Check;
  70.             temp1 := inpath;
  71.             Convert(pagecount,temp2);
  72.             For counter := 74-Length(temp2) downto Length(temp1) do
  73.               temp1 := Concat(temp1,' ');
  74.             Insert('Page ',temp1,74-Length(temp2));
  75.             Insert(temp2,temp1,79-Length(temp2));
  76.             WRITELN(temp1);
  77.             WRITELN;
  78.           END;
  79.     END{Header};
  80.   PROCEDURE Parse(VAR tmp: STR255);
  81.     VAR
  82.       p1,
  83.       p2,
  84.       p3,
  85.       lp: INTEGER;
  86.     BEGIN
  87.       Abort_Check;
  88.       p1 := POS('$I', tmp);
  89.       p2 := POS('$i', tmp);
  90.       IF p2 > p1
  91.         THEN
  92.           p1 := p2;
  93.       p1 := p1 + 2;
  94.       p2 := 0;
  95.       p3 := 0;
  96.       FOR lp := p1 to LENGTH(tmp) DO
  97.         IF (p2 = 0) AND (tmp[lp] <> ' ')
  98.           THEN
  99.             p2 := lp
  100.           ELSE
  101.             IF ( (p2 <> 0) AND
  102.                ( (tmp[lp] = ' ') OR (tmp[lp] = '}') OR (tmp[lp] = '*') ) AND
  103.                (p3 = 0) )
  104.               THEN
  105.                 p3 := lp;
  106.       tmp := COPY(tmp, p2, (p3 - p2));
  107.       IF ( POS('.', tmp) = 0 )
  108.         THEN
  109.           tmp := CONCAT(tmp, '.PAS');
  110.       IF (tmp[2] <> ':')
  111.         THEN
  112.           tmp := CONCAT('A:\', tmp);
  113.       FOR lp := 1 to LENGTH(tmp) DO
  114.         BEGIN
  115.           IF tmp[lp] IN ['a'..'z']
  116.             THEN
  117.               BEGIN
  118.                 p1 := ORD(tmp[lp]) - ORD('a') + ORD('A');
  119.                 tmp[lp] := CHR(p1);
  120.               END;
  121.         END;
  122.       IF (tmp[1] <> 'A')
  123.         THEN
  124.           tmp[1] := 'A';
  125.     END{Parse};
  126.  
  127.     PROCEDURE Do_Reinsert;
  128.       BEGIN
  129.         choice := Do_Alert('[3][ | |Re-Insert Former Disk][ OK | Cancel ]',1);
  130.         IF choice = 2
  131.           THEN
  132.             HALT;
  133.       END{Do_Reinsert};
  134.  
  135.  
  136.     PROCEDURE List(f_name: STR255);
  137.       LABEL
  138.         1;
  139.       VAR
  140.         choice: INTEGER;
  141.         f_var,
  142.         f_var2: TEXT;
  143.         box_text: STR255;
  144.         re_do_disk: BOOLEAN;
  145.       BEGIN
  146.         Abort_Check;
  147.         re_do_disk := FALSE;
  148.         choice := 0;
  149.         IO_Check(FALSE);
  150.         Reset(f_var, f_name);
  151.         IF (IO_Result <> 0)
  152.           THEN
  153.             REPEAT
  154.               re_do_disk := TRUE;
  155.               box_text := '[1][ |File Not Found. |Please Insert ';
  156.               box_text := CONCAT(box_text, 'Source Disk |for File: ');
  157.               box_text := CONCAT(box_text,f_name, ' ][ OK | Ignore | Abort ]');
  158.               choice := Do_Alert(box_text, 1);
  159.               IF (choice = 3)
  160.                 THEN
  161.                   HALT
  162.                 ELSE
  163.                   IF (choice = 2)
  164.                     THEN
  165.                       BEGIN
  166.                         re_do_disk := FALSE;
  167.                         GOTO 1;
  168.                       END;
  169.               Reset(f_var, f_name);
  170.             UNTIL (IO_Result = 0);
  171.         IO_Check(TRUE);
  172.         READLN(f_var, working);
  173.         While not EOF(f_var) do
  174.           BEGIN
  175.             Abort_Check;
  176.             Convert(linecount,linestr);
  177.             IF (Length(working) <= 74) and (l_numbers)
  178.               THEN
  179.                 BEGIN
  180.                   While Length(linestr) < 6 do
  181.                     linestr := Concat(linestr,' ');
  182.                   working := Concat(linestr,working);
  183.                 END;
  184.             WRITELN(working);
  185.             linecount := linecount+1;
  186.             counter := counter+1;
  187.             IF ( counter > c_lines_per_page )
  188.               THEN
  189.                 BEGIN
  190.                   pagecount := pagecount+1;
  191.                   PAGE;
  192.                   Header;
  193.                   counter := 1;
  194.                 END;
  195.  
  196.             IF ( (POS('$I', working) + POS('$i', working)) > 0 ) AND
  197.                (c_include_files_are_printed)
  198.               THEN
  199.                 BEGIN
  200.                   Parse(working);
  201.                   IF (POS(',', working) = 0)
  202.                     THEN
  203.                       BEGIN
  204.                         IF ((working <> 'A:\GEMCONST.PAS') AND
  205.                             (working <> 'A:\GEMSUBS.PAS')  AND
  206.                             (working <> 'A:\GEMTYPE.PAS')    ) OR
  207.                             (c_oss_files_are_printed)
  208.                           THEN
  209.                             BEGIN
  210.                               box_text := CONCAT(
  211.                                 '[2][ |Print include file:|', working);
  212.                               box_text := CONCAT(box_text,'][ Yes | No ]');
  213.                               IF ( Do_Alert(box_text, 1) = 1 )
  214.                                 THEN
  215.                                   List(working);
  216.                             END;
  217.                       END;
  218.                 END;
  219.             READLN(f_var, working);
  220.           END;
  221.         CLOSE(f_var);
  222.         1:
  223.         IF re_do_disk
  224.           THEN
  225.             Do_Reinsert;
  226.       END{List};
  227.  
  228.   BEGIN {MAIN}
  229.     IF (Init_Gem < 0)
  230.       THEN
  231.         HALT;
  232.     pagecount := 1;
  233.     linecount := 1;
  234.     IF c_ask_for_source
  235.       THEN
  236.         BEGIN
  237.           lert := '[3][ "Print" by Barry Larson. | Portions (c) by ';
  238.           lert := CONCAT(lert,'OSS, Inc. | ');
  239.           lert := CONCAT(lert,'Insert Pascal Source Disk][ OK | Cancel ]');
  240.           choice := Do_Alert(lert, 1);
  241.           IF (choice <> 1)
  242.             THEN
  243.               HALT;
  244.         END;
  245.     defpath := c_default_path;
  246.     IF (Get_In_File(defpath,inpath))
  247.       THEN
  248.         BEGIN
  249.           test := Copy(inpath,Length(inpath),1);
  250.           IF test = '\'
  251.             THEN
  252.               HALT;
  253.           choice := 1;
  254.           IF c_offer_line_numbers
  255.             THEN
  256.               choice := Do_Alert
  257.                 ('[2][ | |Print with line numbers][ No | Yes | Cancel ]',1);
  258.           IF choice = 2
  259.             THEN
  260.               l_numbers := TRUE;
  261.           IF choice = 3
  262.             THEN
  263.               HALT;
  264.           Rewrite(Output,'PRN:');
  265.           Header;
  266.           counter := 1;
  267.           List(inpath);
  268.           IF c_final_form_feed
  269.             THEN
  270.               PAGE;
  271.           PAGE;
  272.         END;
  273.     Exit_Gem;
  274.   END {MAIN}.
  275.